home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Game-Power
/
Amiga Game-Power.iso
/
anwendungen
/
videodatei
/
videomenue
/
vime3
(
.txt
)
< prev
Wrap
AmigaBASIC Source Code
|
1994-05-20
|
9KB
|
342 lines
REM ********************************
REM *** V I D E O M E N U E ***
REM ***--------------------------***
REM *** © by Andreas Hoyer ***
REM ***--------------------------***
REM *** Generation3 25-Jul-1989 ***
REM ********************************
SCREEN 1,640,220,2,2
WINDOW 1," VIDEO MENUE Gen3 © by A.Hoyer Tue-25-07-1989 ",,,1
start:
f=0:ON ERROR GOTO fehler
menue:
CLS
LOCATE 3,23:PRINT "--===**** VIDEO MENUE ****===--"
LOCATE 5,23:PRINT "<-1-> .......... Daten eingeben"
LOCATE 7,23:PRINT "<-2-> .......... Daten anzeigen"
LOCATE 9,23:PRINT "<-3-> .......... Daten suchen"
LOCATE 11,23:PRINT "<-4-> .......... Daten ändern"
LOCATE 13,23:PRINT "<-5-> .......... Daten löschen"
LOCATE 15,23:PRINT "<-6-> .......... Daten von bis"
LOCATE 17,23:PRINT "<-7-> .......... Programm Ende"
LOCATE 20,18:PRINT"Bitte wählen Sie mit der linken Maustaste!"
LINE (170,12)-(430,138),,b
LINE (173,14)-(427,24),,b
LINE (167,10)-(433,140),,b
LINE (170,122)-(430,124),,b
FOR a=30 TO 140 STEP 16
LINE (174,a)-(217,a+10),,b
NEXT a
where:
WHILE 1
IF MOUSE(0)=0 THEN WEND
CALL maus(x,y)
IF x<174 OR x>217 THEN where
IF y<30 OR y>142 THEN where
IF x>174 AND x<217 AND y>30 AND y<40 THEN eingeben
IF x>174 AND x<217 AND y>46 AND y<56 THEN anzeigen
IF x>174 AND x<217 AND y>62 AND y<72 THEN suchen
IF x>174 AND x<217 AND y>78 AND y<88 THEN aendern
IF x>174 AND x<217 AND y>94 AND y<104 THEN killing
IF x>174 AND x<217 AND y>110 AND y<120 THEN alles
IF x>174 AND x<217 AND y>126 AND y<136 THEN ende
GOTO where
eingeben:
CLS
LOCATE 2,3:PRINT "Daten eingeben:":LOCATE 3,3:PRINT "---------------"
LOCATE 5,5:INPUT "Cassettennummer :";casnu$
IF casnu$="" THEN menue
LOCATE 7,5:INPUT "Cassettenlänge E-";e$
IF e$="" THEN menue
CLS
FOR a=1 TO 5
PRINT
PRINT " "a". Film:"
INPUT " Name : ";nam$(a)
INPUT " Dauer: ";tim$(a)
NEXT a
GOSUB aeok
LOCATE 22,16:PRINT "Noch eine Cassette eingeben? J N"
LINE (355,166)-(397,176),,b:LINE (375,166)-(375,176)
nece:
GOSUB mausa
IF x<355 OR x>397 THEN nece
IF y<166 OR y>176 THEN nece
IF x>355 AND x<375 AND y>166 AND y<176 THEN eingeben
IF x>375 AND x<397 AND y>166 AND y<176 THEN menue
GOTO nece
anzeigen:
CLS
LOCATE 2,3:PRINT "Daten anzeigen:":LOCATE 3,3:PRINT "---------------"
LOCATE 5,5:INPUT "Cassettennummer";casnu$
IF casnu$=""THEN menue
LOCATE 7,5:PRINT "Einen Moment bitte..."
GOSUB laden
GOSUB inhalt
LOCATE 22,16:PRINT "Noch eine Cassette anzeigen? J N"
LINE (355,166)-(397,176),,b:LINE (375,166)-(375,176)
neca:
GOSUB mausa
IF x<355 OR x>397 THEN neca
IF y<166 OR y>176 THEN neca
IF x>355 AND x<375 AND y>166 AND y<176 THEN anzeigen
IF x>375 AND x<397 AND y>166 AND y<176 THEN menue
GOTO neca
aendern:
CLS
LOCATE 2,3:PRINT "Daten ändern:":LOCATE 3,3:PRINT "-------------"
LOCATE 5,5:INPUT "Welche Nummer";casnu$
IF casnu$="" THEN menue
LOCATE 7,5:PRINT "Einen Moment bitte..."
GOSUB laden
GOSUB inhalt
aend:
LOCATE 23,5:INPUT "Film ändern (1-5), Cassettenlänge (6) oder Menue (7)";aen
IF aen<0 OR aen >6 THEN menue
IF aen=6 THEN caslch
CLS
PRINT:PRINT " "a". Film der Cassette ";casnu$;":"
PRINT:PRINT " Name:";nam$(aen)
PRINT " Dauer:";tim$(aen)
PRINT:PRINT "Neue Daten:":a=aen
PRINT:INPUT " Name:";nam$(a)
INPUT " Dauer:";tim$(a)
GOTO aeneu
caslch:
INPUT " Cassettenlänge";e$
IF e$="" THEN caslch
aeneu:
GOSUB inhalt
aeok:
LOCATE 22,20:PRINT "Sind alle Daten richtig? J N"
LINE (355,166)-(397,176),,b:LINE (375,166)-(375,176)
chok:
GOSUB mausa
IF x<355 OR x>397 THEN chok
IF y<166 OR y>176 THEN chok
IF x>355 AND x<375 AND y>166 AND y<176 THEN speicher
IF x>375 AND x<397 AND y>166 AND y<176 THEN aend
GOTO chok
killing:
CLS
LOCATE 2,3:PRINT "Daten löschen:":LOCATE 3,3:PRINT "--------------"
LOCATE 5,5:INPUT "Welche Cassette";casnu$
IF casnu$="" THEN menue
GOSUB laden
GOSUB inhalt
LOCATE 22,28:PRINT "Sind Sie sicher? J N"
LINE (355,166)-(397,176),,b:LINE (375,166)-(375,176)
killit:
GOSUB mausa
IF x<355 OR x>397 THEN killit
IF y<166 OR y>176 THEN killit
IF x>355 AND x<375 AND y>166 AND y<176 THEN killer
IF x>375 AND x<397 AND y>166 AND y<176 THEN menue
GOTO killit
killer:
PRINT " Einen Moment bitte..."
a$="DATEN/Cass. "+casnu$
KILL a$
KILL a$+".info"
GOTO menue
alles:
CLS
LOCATE 2,3:PRINT "Daten von bis:":LOCATE 3,3:PRINT "--------------"
LOCATE 5,5:INPUT "Ab Cassette";von
IF von<=0 THEN menue
LOCATE 7,5:INPUT "bis Cassette";bis
IF bis <=0 OR bis <von THEN menue
FOR mal=von TO bis
casnu$=STR$(mal)
GOSUB lade
GOSUB inhalt
LOCATE 22,20:PRINT "Leertaste für weiter, F1 für Menue!"
show:
i$=INKEY$
IF i$=" " THEN showon
IF i$=CHR$(129) THEN menue
GOTO show
showon:
NEXT mal
GOTO menue
laden:
a$="DATEN/Cass. "+casnu$
OPEN "I",#1,a$
FOR a=1 TO 5
INPUT #1,e$,nam$(a),tim$(a)
NEXT a
CLOSE #1
RETURN
lade:
a$="DATEN/Cass."+casnu$
OPEN "I",#1,a$
FOR a=1 TO 5
INPUT #1,e$,nam$(a),tim$(a)
NEXT a
CLOSE #1
RETURN
speicher:
PRINT:PRINT " Einen Moment bitte..."
a$="DATEN/Cass. "+casnu$
OPEN "O",#1,a$
FOR a=1 TO 5
WRITE #1,e$,nam$(a),tim$(a)
NEXT a
CLOSE #1
KILL a$+".info"
GOTO menue
speichern:
PRINT:PRINT " Einen Moment bitte..."
a$="DATEN/Cass. "+casnu$
OPEN "O",#1,a$
FOR a=1 TO 5
WRITE #1,e$,nam$(a),tim$(a)
NEXT a
CLOSE #1
KILL a$+".info"
RETURN
inhalt:
CLS:LOCATE 1,20:PRINT "Inhalt von Cassette ";casnu$;" (E-";e$;")"
FOR a=1 TO 5
PRINT
PRINT " "a". Film:"
PRINT " Name : ";nam$(a)
PRINT " Dauer: ";tim$(a)
NEXT a
RETURN
mausa:
WHILE 1
IF MOUSE(0)=0 THEN WEND
CALL maus(x,y)
RETURN
ende:
LOCATE 22,28:PRINT "Sind Sie sicher? J N"
LINE (355,166)-(397,176),,b:LINE (375,166)-(375,176)
rett:
WHILE 1
v=MOUSE(0)
IF MOUSE(0)=0 THEN WEND
CALL maus(x,y)
IF x<355 OR x>397 THEN rett
IF y<166 OR y>176 THEN rett
IF x>355 AND x<375 AND y>166 AND y<176 THEN aus
IF x>375 AND x<397 AND y>166 AND y<176 THEN menue
GOTO rett
fehler:
IF ERR=61 THEN RESUME full :REM Disk is full
IF ERR=53 AND f=1 THEN RESUME nichts :REM Film existiert nicht
IF ERR=53 AND f=2 THEN RESUME keinec :REM Cassette existiert nicht
IF ERR=53 THEN RESUME finf :REM file not found
IF ERR=70 THEN RESUME writ :REM Disk is write protectet
END
full:
CLS:BEEP
LOCATE 5,5:PRINT "Die Diskette ist zu voll um die letzten Daten noch zu speichern!"
LOCATE 7,5:PRINT "Bitte legen Sie eine andere Diskette mit einem 'DATEN' Directory"
LOCATE 9,5:PRINT "in das von Ihnen benützte Laufwerk!"
LOCATE 15,5:PRINT"Drücken Sie auf die Leertaste, wenn Sie die Disketten gewechselt haben!"
fullw:
i$=INKEY$
IF i$=" " THEN GOTO start
GOTO fullw:
finf:
CLS:BEEP
LOCATE 5,5:PRINT "Auf dieser Diskette befindet sich keine Datei mit diesem Namen!"
LOCATE 15,5:PRINT"Drücken Sie auf die Leertaste um das Programm weiterzuführen!"
finfw:
i$=INKEY$
IF i$=" " THEN GOTO start
GOTO finfw:
writ:
CLS:BEEP
LOCATE 5,5:PRINT " Diese Diskette ist Schreibgeschützt, es können keine Daten"
LOCATE 7,5:PRINT "darauf abgespeichert werden. Bitte entfernen Sie den Schreibschutz."
LOCATE 15,5:PRINT"Drücken Sie auf die Leertaste um das Programm weiterzuführen!"
writw:
i$=INKEY$
IF i$=" " THEN GOTO start
GOTO writw:
suchen:
CLS
LOCATE 1,3:PRINT "Daten suchen"
LOCATE 2,3:PRINT "------------"
LOCATE 4,5:INPUT "Welchen Film suchen ";fina$
IF fina$=""THEN menue
LOCATE 6,5:INPUT "Ab welcher Cassette ";cas
IF cas<1 THEN menue
LOCATE 8,5:PRINT "BITTE WARTEN ..."
LOCATE 10,5:PRINT "Ich suche auf Cassette :"
REM ---*** 500 ist die maximale Zahl der VCassetten ***---
FOR s=cas TO 500
f=1:LOCATE 10,30:PRINT s
a$="DATEN/Cass."+STR$(s)
OPEN "I",#1,a$
FOR a=1 TO 5
INPUT #1,e$,nam$(a),tim$(a)
IF nam$(a) = fina$ THEN gefunden
NEXT a
CLOSE #1
NEXT s
nichts:
CLS:BEEP:LOCATE 5,20:PRINT "Leider wurde der Film nicht gefunden!"
FOR z=1 TO 5000:NEXT
GOTO menue
keinec:
CLS:BEEP:LOCATE 5,23:PRINT "Diese Cassette existiert nicht !"
FOR z=1 TO 5000:NEXT
GOTO menue
gefunden:
CLS:BEEP
LOCATE 5,5:PRINT nam$(a);" ist der"
LOCATE 7,5:PRINT a". Film auf Cassette ";s;" (E-";e$;")"
LOCATE 9,5:PRINT "und dauert ";tim$(a);"."
LOCATE 20,25:PRINT "LEERTASTE für Menü!"
gef:
i$=INKEY$:IF i$<>" " THEN gef
RUN :REM WICHTIG !!!
SUB maus(x,y) STATIC
x= MOUSE(1)
y= MOUSE(2)
END SUB
aus:
CLS
SYSTEM